home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 2002 November / SGI Freeware 2002 November - Disc 1.iso / dist / fw_exmh.idb / usr / freeware / lib / exmh-2.5 / pgpExec.tcl.z / pgpExec.tcl
Text File  |  2002-07-08  |  25KB  |  797 lines
  1. # pgpInterface.tcl -- 
  2. # created by monnier@didec26.epfl.ch on Mon Dec 12 17:34:38 1994
  3.  
  4. # 
  5. # 
  6. # 
  7.  
  8. # $Log: pgpExec.tcl,v $
  9. # Revision 1.15  2000/09/21 15:06:44  valdis
  10. # Catch PGP stderr so 'Get key' and 'Generate Key' work...
  11. #
  12. # Revision 1.14  2000/06/16 18:16:26  valdis
  13. # Various PGP fixes...
  14. #
  15. # Revision 1.13  2000/06/15 17:03:11  valdis
  16. # Add X-Mailer: change, fix PGP Comment: line...
  17. #
  18. # Revision 1.12  2000/04/18 18:38:33  valdis
  19. # Fix quote character to use ascii rather than iso8859-ish one
  20. #
  21. # Revision 1.11  1999/09/27 23:18:45  kchrist
  22. # More PGP changes. Consolidated passphrase entry to sedit field or
  23. # pgpExec routine. Made the pgp-sedit field aware of pgp(keeppass)
  24. # and pgp(echopass). Moved pgp(keeppass), pgp(echopass) and
  25. # pgp(grabfocus) to PGP General Interface. Fixed a minor bug left
  26. # over from my previous GUI changes. Made pgp-sedit field appear and
  27. # disappear based on its enable preference setting.
  28. #
  29. # Revision 1.10  1999/09/22 16:36:44  kchrist
  30. # Changes made to support a different structure under the PGP Crypt... button.
  31. # Instead of an ON/OFF pgp($v,sign) variable now we use it to specify
  32. # the form of the signature (none, standard, detached, clear, or w/encrypt).
  33. # Code changed in several places to support this new variable definition.
  34. #
  35. # Updated Sedit.html to include a description of the new interface.
  36. #
  37. # Revision 1.9  1999/08/22 18:57:36  bmah
  38. # Sanitize PGP debugging entries before writing via Exmh_Debug.
  39. #
  40. # Revision 1.8  1999/08/13 00:39:05  bmah
  41. # Fix a number of key/passphrase management problems:  pgpsedit now
  42. # manages PGP versions, keys, and passphrases on a per-window
  43. # basis.  Decryption now works when no passphrases are cached.
  44. # One timeout parameter controls passphrases for all PGP
  45. # versions.  seditpgp UI slightly modified.
  46. #
  47. # Revision 1.7  1999/08/04 22:43:39  cwg
  48. # Got passphrase timeout to work yet again
  49. #
  50. # Revision 1.6  1999/08/04 16:30:17  cwg
  51. # Don't prompt for a passphrase when we shouldn't.
  52. #
  53. # Revision 1.5  1999/08/03 04:05:54  bmah
  54. # Merge support for PGP2/PGP5/GPG from multipgp branch.
  55. #
  56. # Revision 1.4.2.1  1999/06/14 20:05:15  gruber
  57. # updated multipgp interface
  58. #
  59. # Revision 1.4  1999/06/10 16:59:18  cwg
  60. # Re-enabled the timeout of PGP passwords
  61. #
  62. # Revision 1.3  1999/05/04 06:35:38  cwg
  63. # Fixed crash when aborting out of PGP Password window
  64. #
  65. # Revision 1.2  1999/04/10 04:20:08  cwg
  66. # Do the right thing if pgp(seditpgp) is not enabled.
  67. #
  68. # Revision 1.1  1998/05/05 17:55:37  welch
  69. # Initial revision
  70. #
  71. # Revision 1.1  1998/05/05 17:42:59  welch
  72. # Initial revision
  73. #
  74. # Revision 1.11  1998/01/22  00:45:06  bwelch
  75. #     Hack to use aixterm for PGP.
  76. #
  77. # Revision 1.10  1997/12/22  20:52:00  bwelch
  78. # file delete
  79. #
  80. # Revision 1.9  1997/07/25  17:13:23  bwelch
  81. # Fixed pattern match to handle PGP 5.0 date format.
  82. #
  83. # Revision 1.8  1997/07/12  23:05:12  bwelch
  84. #     Fixed PGP key extraction from the web servers.
  85. #     Fixed handling of failed signatures so you still see the message.
  86. #
  87. # Revision 1.7  1997/06/03  18:29:55  bwelch
  88. # Added PGP grab-focus and use-expecttk options.
  89. # Removed +keepbinary=off flag from PGP uses.
  90. # PGP bin directory is added to the front of PATH, if necessary
  91. #
  92. # Revision 1.6  1997/01/25  05:29:23  bwelch
  93. #     Tweaked PgpExec_KeyList that returns a list of keys.
  94. #     Tweaked patterns on PGP output.
  95. #     Added Pgp_ShortenOutput
  96. #
  97. # Revision 1.5  1996/12/21  00:57:12  bwelch
  98. # Log errors from PGP key extraction
  99. #
  100. # Revision 1.4  1996/12/01  20:13:59  bwelch
  101. # Added Pgp_InterpretOutput
  102. # Added timeouts on password caching.
  103. #
  104. # Revision 1.3  1996/03/22  18:42:54  bwelch
  105. # Added Mh_Rename
  106. # .
  107. #
  108. # Revision 1.2  1995/05/24  05:58:04  bwelch
  109. # Updates from Stefan
  110. #
  111. # Revision 1.1  1995/05/19  17:36:16  bwelch
  112. # Initial revision
  113. #
  114. # Revision 1.2  1995/03/22  19:14:21  welch
  115. # More new code from Stefan
  116. #
  117. # Revision 1.1  1994/12/30  21:49:00  welch
  118. # Initial revision
  119. #
  120. # Revision 1.1  1994/12/17  20:19:16  monnier
  121. # Initial revision
  122. #
  123.  
  124. # execs pgp with the usual flags
  125. proc Pgp_Exec { v exectype arglist outvar {privatekey {}} {interactive 0} } {
  126.     global pgp env
  127.     upvar $outvar output
  128.  
  129.     Exmh_Debug "Pgp_Exec $v $exectype $arglist $outvar $privatekey $interactive"
  130.  
  131.     if {![set pgp($v,enabled)]} {
  132.     error "<[set pgp($v,fullName)]> isn't enabled"
  133.     }
  134.  
  135.     set output {}
  136.     if {![set pgp(keeppass)]} {
  137.     Pgp_ClearPassword $v
  138.     }
  139.     if {$interactive || !([set pgp(keeppass)] || ($privatekey == {}))} {
  140.         Exmh_Debug "<Pgp_Exec> Pgp_Exec_Interactive $v $exectype $arglist output"
  141.     return [Pgp_Exec_Interactive $v $exectype $arglist output]
  142.     } else {
  143.     if {$privatekey == {}} {
  144.             Exmh_Debug "<PGP Pgp_Exec> Pgp_Exec_Batch $v $exectype $arglist output"
  145.         return [Pgp_Exec_Batch $v $exectype $arglist output]
  146.     } else {
  147.         Exmh_Debug v=$v
  148.  
  149.         set keyid [lindex $privatekey 0]
  150.         Exmh_Debug keyid=$keyid
  151.         # Check for passphrase. Pgp_GetPass is cache and expire aware!
  152.         set p [Pgp_GetPass $v $privatekey]
  153.         #Exmh_Debug "<Pgp_Exec> got passwd >$p<"
  154.  
  155.         if {[string length $p] == 0} {
  156.         return 0
  157.         }
  158.             Exmh_Debug "<Pgp_Exec> Pgp_Exec_Batch $v $exectype $arglist output \(password\)"
  159.         return [Pgp_Exec_Batch $v $exectype $arglist output $p]
  160.     }
  161.     }
  162. }
  163.  
  164. # batch mode
  165. proc Pgp_Exec_Batch { v exectype arglist outvar {password {}} } {
  166.     global pgp exmh errorCode
  167.     upvar $outvar output
  168.  
  169.     Exmh_Debug "Pgp_Exec_Batch $v $exectype $arglist $outvar \(password\)"
  170.  
  171.     set tclcmd [concat exec [set pgp($v,executable,$exectype)] \
  172.                               [subst [set pgp($v,flags_batch)]] $arglist]
  173.  
  174.     Exmh_Debug "<Pgp_Exec_Batch> $tclcmd"
  175.  
  176.     # Set file descriptor for passphrase on stdin
  177.     if {$password == {}} {
  178.         Pgp_${v}_PassFdUnset
  179.     } else {
  180.         lappend tclcmd << $password
  181.         Pgp_${v}_PassFdSet
  182.     }
  183.  
  184.     set result [catch {eval $tclcmd |& cat} output]
  185.     Exmh_Debug "<Pgp_Exec_Batch>: Exit status: $result $errorCode"
  186.  
  187.     # Unset file descriptor for passphrase
  188.     Pgp_${v}_PassFdUnset
  189.  
  190.     regsub -all "\x07" $output "" output
  191.     return $result
  192. }
  193.  
  194. # interactive mode
  195. proc Pgp_Exec_Interactive { v exectype arglist outvar } {
  196.     global tcl_platform pgp
  197.     upvar $outvar output
  198.  
  199.     Exmh_Debug "Pgp_Exec_Interactive $v $exectype $arglist $outvar"
  200.  
  201.     set pgpcmd [set pgp($v,executable,$exectype)]
  202.     set args [concat [subst [set pgp($v,flags_interactive)]] $arglist]
  203.  
  204.     # Be sure, that passphrase isn't read from stdin
  205.     Pgp_${v}_PassFdUnset
  206.  
  207.     # Build shellcommand
  208.     set shcmd "
  209.         $pgpcmd \"[join [Pgp_Misc_Map x {
  210.         regsub {([$\"\`])} $x {\\1} x
  211.         set dummy $x
  212.         } $args] {" "}]\";
  213.     echo
  214.     echo press Return...;
  215.         read dummy"
  216.  
  217.     set logfile [Mime_TempFile "xterm"]
  218.     if { ( $tcl_platform(os) == "AIX" ) && [ file executable "/usr/bin/X11/aixterm" ] } {
  219.         set xterm "aixterm"
  220.     } else {
  221.         set xterm "xterm"
  222.     }
  223.  
  224.     # Hint: XFree86 xterm does not support output logging (Markus)
  225.     # -l and -lf not supported
  226.  
  227.     set tclcmd {exec $xterm -l -lf $logfile -title [set pgp($v,fullName)] -e sh -c $shcmd}
  228.     Exmh_Debug "<Pgp_Exec_Interactive> $tclcmd"
  229.     set result [catch $tclcmd]
  230.     if [catch {open $logfile r} log] {
  231.     set output {}
  232.     } else {
  233.     set output [read $log]
  234.     close $log
  235.     }
  236.  
  237.     eval [set pgp($v,cmd_cleanOutput)]
  238.  
  239.     return $result
  240. }
  241.  
  242. proc Pgp_Exec_CheckPassword { v password key } {
  243.     global pgp
  244.  
  245.     Exmh_Debug "Pgp_Exec_CheckPassword $v \(password\) $key"
  246.  
  247.     set in [Mime_TempFile "pwdin"]
  248.     set out [Mime_TempFile "pwdout"]
  249.     set filio [open $in w 0600]
  250.     puts $filio "salut"
  251.     close $filio
  252.     set keyid [lindex $key 0]
  253.  
  254.     Pgp_Exec_Batch $v sign [subst [set pgp($v,args_signClear)]] err $password
  255.  
  256.     File_Delete $in
  257.  
  258.     # pgp thinks he knows better how to name files !
  259.     if {![file exists $out] && [file exists "$out.asc"]} {
  260.     Mh_Rename "$out.asc" $out
  261.     }
  262.     if {![file exists $out]} {
  263.         if [regexp [set pgp($v,pat_checkError)] $err x match] {
  264.             Exmh_Status ?${match}?
  265.         }
  266.         Exmh_Debug "<Pgp_Exec_CheckPassword> $err"
  267.     return 0
  268.     } else {
  269.     File_Delete $out
  270.     return 1
  271.     }
  272. }
  273.  
  274. # returns a list of keys. Each "key" is a list whose first four elements are
  275. # keyid algo subkeyid algo
  276. # and the next ones are the corresponding userids
  277. # {keyid algo subkeyid algo userid userid userid ...}
  278. proc Pgp_Exec_KeyList { v pattern keyringtype } {
  279.     global pgp
  280.  
  281.     Exmh_Debug "Pgp_Exec_Keylist $v $pattern $keyringtype"
  282.  
  283.     set pattern [string trimleft $pattern "<>|2"]
  284.     set arglist [subst [set pgp($v,args_list$keyringtype)]]
  285.     ldelete arglist {}
  286.  
  287.     Pgp_Exec_Batch $v key $arglist keylist
  288.  
  289.     Exmh_Debug "<Pgp_Exec_Keylist>: $keylist"
  290.  
  291.     # drop revoked and noninteresting keys
  292.     regsub -all [set pgp($v,pat_dropKeys)] $keylist {} keylist
  293.  
  294.     # Form a list of keys
  295.     regsub -all [set pgp($v,pat_splitKeys)] $keylist \x81 keylist
  296.     set keylist [split $keylist \x81]
  297.  
  298.     Exmh_Debug "<Pgp_Exec_Keylist>: Splitted keylist: $keylist"
  299.  
  300.     # Match out interesting keys
  301.     set keypattern [set pgp($v,pat_key$keyringtype)]
  302.  
  303.     # subkeyparsing
  304.     if [info exists pgp($v,pat_key${keyringtype}_sub)] {
  305.         set subkeypattern [set pgp($v,pat_key${keyringtype}_sub)]
  306.     }
  307.  
  308.     # uid parsing
  309.     set uidpattern [set pgp($v,pat_uid)]
  310.  
  311.     # grep keys
  312.     set AllowedToFollow 0
  313.     set keys {}
  314.     foreach line $keylist {
  315.         catch {unset userid}
  316.         catch {unset keyid}
  317.         set goodline 0
  318.         #
  319.         if {[eval [set pgp($v,cmd_keyMatch)]]} {
  320.             if {[info exists userids] && [info exists keyids]} {
  321.                 if {[llength $keyids] < 4} {
  322.                     lappend keyids {} {}
  323.                 }
  324.                 lappend keys [concat $keyids $userids]
  325.                 unset keyids
  326.                 unset userids
  327.             }
  328.             lappend keyids "0x$keyid" $algo
  329.             catch {lappend userids $userid}
  330.             set AllowedToFollow 1
  331.             set goodline 1
  332.         }    
  333.         if [info exists subkeypattern] {
  334.             if {[eval [set pgp($v,cmd_keyMatch_sub)]] && $AllowedToFollow} {
  335.                 lappend keyids "0x$keyid" $algo
  336.                 set goodline 1
  337.             }
  338.         }
  339.         if {[eval [set pgp($v,cmd_uidMatch)]] && $AllowedToFollow} {
  340.             lappend userids $userid
  341.             set goodline 1
  342.         }
  343.         if {!$goodline} {
  344.             set AllowedToFollow 0
  345.         }
  346.     }
  347.     if {[info exists userids] && [info exists keyids]} {
  348.         if {[llength $keyids] < 4} {
  349.             lappend keyids {} {}
  350.         }
  351.         lappend keys [concat $keyids $userids]
  352.     }
  353.  
  354.     # keys is of the format { {keyid algo subkeyid algo userid userid} {} {}...}
  355.     return $keys
  356. }
  357.  
  358. # parse config file
  359. # this is only needed to set pgp($v,myname)
  360. proc Pgp_Exec_ParseConfigTxt { v file } {
  361.     global pgp
  362.  
  363.     Exmh_Debug "Pgp_Exec_ParseConfigTxt $file"
  364.  
  365.     if [catch {open $file r} in] {
  366.     return
  367.     }
  368.     for {set len [gets $in line]} {$len >= 0} {set len [gets $in line]} {
  369.     if [regexp -nocase "^\[ \t]*(\[a-z]+)\[ \t]*=(\[^#]*)" $line {} option value] {
  370.         set pgp($v,config,[string tolower $option]) [string trim $value " \t\""]
  371.     }
  372.     }
  373.     close $in
  374. }
  375.  
  376.  
  377. ###############
  378. # Encrypt/Sign
  379.  
  380. proc Pgp_Exec_Encrypt { v in out tokeys } {
  381.     global pgp
  382.  
  383.     Exmh_Debug "Pgp_Exec_Encrypt $v $in $out $tokeys"
  384.  
  385.     Pgp_Exec_Batch $v encrypt [subst [set pgp($v,args_encrypt)]] output
  386.     if {[Pgp_Exec_CheckSuccess $v $out $output "encrypted text"]} {
  387.         # pgp refuses to generate an encrypted message
  388.         # if a key was untrusted
  389.         # interactively proceed
  390.         Pgp_Exec_Interactive $v encrypt [subst [set pgp($v,args_encrypt)]] output
  391.     }
  392. }
  393.  
  394. proc Pgp_Exec_EncryptSign { v in out sigkey tokeys } {
  395.     global pgp
  396.  
  397.     Exmh_Debug "Pgp_Exec_EncryptSign $v $in $out $tokeys"
  398.  
  399.     set keyid [lindex $sigkey 0]
  400.     Pgp_Exec $v encrypt [subst [set pgp($v,args_encryptSign)]] output $sigkey
  401.     if {[Pgp_Exec_CheckSuccess $v $out $output "signed and encrypted text"]} {
  402.         # pgp refuses to generate an encrypted/signed message
  403.         # if a key was untrusted
  404.         # interactively proceed
  405.         Pgp_Exec $v encrypt [subst [set pgp($v,args_encryptSign)]] output $sigkey 1
  406.     }
  407. }
  408.  
  409. proc Pgp_Exec_Sign { v in out sigkey opt } {
  410.     global pgp
  411.  
  412.     Exmh_Debug "Pgp_Exec_Sign $v $in $out $sigkey $opt"
  413.  
  414.     set keyid [lindex $sigkey 0]
  415.     switch $opt {
  416.     standard {Pgp_Exec $v sign [subst [set pgp($v,args_signBinary)]] output $sigkey}
  417.     detached {Pgp_Exec $v sign [subst [set pgp($v,args_signDetached)]] output $sigkey}
  418.     clearsign {Pgp_Exec $v sign [subst [set pgp($v,args_signClear)]] output $sigkey}
  419.     default {set output "Pgp_Exec_Sign error. Unknown option."}
  420.     }
  421.     Pgp_Exec_CheckSuccess $v $out $output "signed text"
  422. }
  423.     
  424. # Look if pgp generated pgp code
  425. proc Pgp_Exec_CheckSuccess {v out output object} {
  426.     global pgp
  427.  
  428.     Exmh_Debug "Pgp_Exec_CheckSuccess $v $out $output $object"
  429.  
  430.     # pgp thinks he knows better how to name files !
  431.     if {![file exists $out] && [file exists "$out.asc"]} {
  432.     Mh_Rename "$out.asc" $out
  433.     }
  434.     if {![file exists $out]} {
  435.         # pgp5 refuses to generate ciphertext in batchmode if tokey is untrusted
  436.         if {[regexp [set pgp($v,pat_Untrusted)] $output]} {
  437.             return 1
  438.         } else {
  439.         error "[set pgp($v,fullName)] refused to generate the ${object}:\n$output"
  440.         }
  441.     } else {
  442.     return 0
  443.     }
  444. }    
  445.  
  446.  
  447. #################
  448. # Decrypt/Verify
  449.  
  450. # get the key to use for decryption
  451. proc Pgp_Exec_GetDecryptKey {v in recipients} {
  452.     global pgp
  453.  
  454.     Exmh_Debug "Pgp_Exec_GetDecryptKey $v $in $recipients"
  455.  
  456.     # If the user has time (this doesn't consume more than a half second)
  457.     # and has set preferences to run pgp twice,
  458.     # run pgp a first time to get out the decryption keyid
  459.     set runtwice 0
  460.     if {[info exists pgp($v,runtwice)] && [set pgp($v,runtwice)]} {
  461.         set runtwice 1
  462.     }
  463.     if {$runtwice} {
  464.       Exmh_Debug "<Pgp_Exec_GetDecryptKey> Pgp_Exec_GetDecryptKeyid $v $in"
  465.       set keyid [Pgp_Exec_GetDecryptKeyid $v $in]
  466.       if {$keyid == {}} {
  467.         return {}
  468.       } elseif {[string match $keyid SYM]} {
  469.         # SYMMETRIC ENCRYPTION
  470.         set key [list SYM {} {} {} "symmetrically encrypted message"]
  471.       } else {
  472.       # One of user's private keys?  If so, than use it.
  473.         foreach key [set pgp($v,privatekeys)] {
  474.           if {[regexp $keyid [lindex $key 0]]} {
  475.             return $key
  476.           } elseif {[regexp $keyid [lindex $key 2]]} {
  477.             return $key
  478.           }
  479.         }
  480.       }
  481.     } else {
  482.       set recipients [string tolower $recipients]
  483.       # Messages get encrypted with the subkey for dsa/elg
  484.       # I don't know if there are subkeyids in the recipients list if dsa/elg
  485.       # Lets search for mainkeys
  486.       set useablekeys [Pgp_Misc_Filter key \
  487.          {[string first [string tolower [string range [lindex $key 0] 2 end]] $recipients] >= 0} \
  488.          [set pgp($v,privatekeys)]]
  489.       # If no mainkeys were found, search for subkeys
  490.       if {[llength $useablekeys] == 0} {
  491.         set useablekeys [Pgp_Misc_Filter key \
  492.          {[string first [string tolower [string range [lindex $key 2] 2 end]] $recipients] >= 0} \
  493.          [set pgp($v,privatekeys)]]
  494.       }
  495.       set knownkeys [Pgp_Misc_Filter key \
  496.          {[info exists pgp($v,pass,[lindex $key 0])]} $useablekeys]
  497.  
  498.       if {[llength $knownkeys] > 0} {
  499.         set key [lindex $knownkeys 0]
  500.       } elseif {[llength $useablekeys] > 0} {
  501.         set key [lindex $useablekeys 0]
  502.       } else {
  503.         set key {}
  504.       }
  505.     }
  506.     return $key
  507. }
  508.  
  509. proc Pgp_Exec_GetDecryptKeyid {v in} {
  510.     global pgp
  511.  
  512.     Exmh_Debug "Pgp_Exec_GetDecryptKeyid $v $in"
  513.  
  514.     Pgp_Exec_Batch $v verify [subst [set pgp($v,args_getDecryptKeyid)]] output
  515.     if {[regexp [set pgp($v,pat_getDecryptKeyid)] $output {} keyid]} {
  516.     } elseif {[regexp [set pgp($v,pat_getDecryptSym)] $output]} {
  517.       set keyid SYM
  518.     } else {
  519.       Exmh_Debug "<Pgp_Exec_GetDecryptKeyid> No key matches"
  520.       return {}
  521.     }
  522.     Exmh_Debug "<Pgp_Exec_GetDecryptKeyid> keyid $keyid"
  523.     return $keyid
  524. }
  525.  
  526. proc Pgp_Exec_Decrypt { v in out outvar recipients } {
  527.     global pgp
  528.     upvar $outvar output
  529.  
  530.     Exmh_Debug "Pgp_Exec_Decrypt $v $in $out $outvar $recipients"
  531.  
  532.     set key [Pgp_Exec_GetDecryptKey $v $in $recipients]
  533.     Exmh_Debug "<Pgp_Exec_Decrypt> $key"
  534.     
  535.     Pgp_Exec $v verify [subst [set pgp($v,args_decrypt)]] output $key
  536. }
  537.  
  538. proc Pgp_Exec_Verify { v in outvar {out {}}} {
  539.     upvar $outvar output
  540.     global pgp
  541.  
  542.     Exmh_Debug "Pgp_Exec_Verify $v $in $outvar $out"
  543.  
  544.     if {$out == {}} {
  545.         Exmh_Debug "<Pgp_Exec_VerifyOnly>: Pgp_Exec_Verify $v $in $outvar $out"
  546.         Pgp_Exec $v verify [subst [set pgp($v,args_verifyOnly)]] output
  547.     } else {
  548.         Exmh_Debug "<Pgp_Exec_VerifyOut>: Pgp_Exec_Verify $v $in $outvar $out"
  549.         Pgp_Exec $v verify [subst [set pgp($v,args_verifyOut)]] output
  550.     }
  551. }
  552.  
  553. proc Pgp_Exec_VerifyDetached { v sig text outvar } {
  554.     upvar $outvar output
  555.     global pgp
  556.  
  557.     Exmh_Debug "Pgp_Exec_VerifyDetached $v $sig $text $outvar"
  558.  
  559.     Pgp_Exec $v verify [subst [set pgp($v,args_verifyDetached)]] output
  560. }
  561.  
  562. ##################
  563. # NOT WITH GNUPG
  564. #
  565. # This is called if expectk is enabled.  It seemed the best (easiest
  566. # for me) way to do it was to have this proc terminate when the
  567. # message is finished displaying just as Exec_Decrypt would do.
  568. # However, this is a problem for the the expectk script
  569. # (PgpDecryptExpect), which may need to communicate with exmh to ask
  570. # for passwords, etc.  
  571.  
  572. # My slow and inelegant solution was to tell exmh-bg all the necessary
  573. # information and let PgpDecryptExpect communicate with exmh-bg,
  574. # exiting when done.
  575. #
  576. proc Pgp_Exec_DecryptExpect { v infile outfile msgvar } {
  577.     global exmh exwin sedit pgp
  578.     upvar $msgvar msg
  579.  
  580.     # First update exmh-bg arrays.  I hope that pgp, getpass,
  581.     # and exwin will be enough.  For exwin seems we have
  582.     # to temporarily change the mtext error to avoid an error when
  583.     # the password window is closed and focus is returned to .msg.t
  584.  
  585.     send $exmh(bgInterp) [list array set pgp [array get pgp]]
  586.     send $exmh(bgInterp) [list array set getpass [array get getpass]]
  587.     send $exmh(bgInterp) [list array set sedit [array get sedit]]
  588.     send $exmh(bgInterp) [list array set exwin [array get exwin]]
  589.     send $exmh(bgInterp) [list set exwin(mtext) .]
  590.  
  591.     if [catch {exec $exmh(expectk) -f $exmh(library)/PgpDecryptExpect \
  592.                         $v $infile $outfile $exmh(bgInterp)} error] {
  593.         Exmh_Debug "<PGP Exec_DecryptExpect> error: $error"
  594.         Exmh_Status "Error executing expect process" warn
  595.     }
  596.  
  597.     set msg [lindex [send $exmh(bgInterp) {list $pgpmsg}] 0]
  598.     send $exmh(bgInterp) [list unset pgpmsg]
  599.  
  600.     # Now reload pass and exwin from exmh-bg
  601.     foreach index [send $exmh(bgInterp) [list array names pgp $v,pass,*]] {
  602.         set pgp($index) [send $exmh(bgInterp) [list set pgp($index)]]
  603.         send $exmh(bgInterp) [list unset pgp($index)]
  604.     }
  605.     # The following appears no longer to be necessary, but now I don't see
  606.     # how to change the position of the getpass window
  607.     #
  608.     #    set exwin(geometry,.getpass) \
  609.     #    [send $exmh(bgInterp) list {$exwin(geometry,.getpass)}]
  610. }
  611.  
  612. ####################
  613.  
  614. proc Pgp_Exec_ExtractKeys { v file outvar {interactive 1} } {
  615.     global env pgp
  616.     upvar $outvar output
  617.  
  618.     Exmh_Debug "Pgp_Exec_ExtractKeys $v $file $outvar $interactive"
  619.  
  620.     set output {}
  621.     if [Pgp_Exec $v key [subst [set pgp($v,args_importKey)]] output {} $interactive] {
  622.         Exmh_Status "Key extract failed"
  623.         Exmh_Debug "<Pgp_Exec_ExtractKeys> $output"
  624.         return 0
  625.     } else {
  626.         Exmh_Debug "<Pgp_Exec_ExtractKeys> $output"
  627.         return 1
  628.     }
  629. }
  630.  
  631. # Get the passphrase for keyinstance key. We also take care of setting
  632. # passphrase timeouts. Return a stored passphrase when possible.
  633. proc Pgp_GetPass { v key } {
  634.     global pgp
  635.  
  636.     Exmh_Debug "Pgp_GetPass $v $key"
  637.  
  638.     if {[lsearch -glob [set pgp($v,privatekeys)] "[lindex $key 0]*"] < 0} {
  639.         return {}
  640.     }
  641.  
  642.     # Search the passphrase "cache". Need to set-timeout here in case
  643.     # the pass phrase was created via the seditpgp entry field.
  644.     # Because of DecryptExpects asymmetric passphrase storage
  645.     # we need to look for both mainkey and subkey separately
  646.     set keyid [lindex $key 0]
  647.     set subkeyid [lindex $key 2]
  648.     if {([info exists pgp($v,pass,$keyid)]) && \
  649.         ([string length $pgp($v,pass,$keyid)] > 0)} {
  650.     Pgp_SetPassTimeout $v $keyid
  651.     if {[string length $subkeyid] > 0} {
  652.         Pgp_SetPassTimeout $v $subkeyid
  653.     }
  654.         return [set pgp($v,pass,$keyid)]
  655.     } elseif {([string length $subkeyid] > 0) && \
  656.         ([info exists pgp($v,pass,$subkeyid)]) && \
  657.         ([string length $pgp($v,pass,$subkeyid)] > 0)} {
  658.     Pgp_SetPassTimeout $v $subkeyid
  659.         return [set pgp($v,pass,$subkeyid)]
  660.     }
  661.  
  662.     # Not in "cache" (or expired) go ask for it.
  663.     while 1 {
  664.     Exmh_Debug "Attempt to get passphrase for [lindex $key 0] [lindex $key 1] [lindex $key 4]"
  665.         if [catch {Pgp_Misc_GetPass $v "Enter [set pgp($v,fullName)] passphrase" \
  666.                                    "Passphrase for [lindex $key 0] [lindex $key 1] [lindex $key 4]"} password] {
  667.             return {}
  668.         } elseif {[string match $keyid SYM]} {
  669.             # SYMMETRIC ENCRYPTION
  670.             return $password
  671.         } elseif {[Pgp_Exec_CheckPassword $v $password $key]} {
  672.             if [set pgp(keeppass)] {
  673.                 set pgp($v,pass,$keyid) $password
  674.         Pgp_SetPassTimeout $v $keyid
  675.                 # Because of DecryptExpect we need to store passphrase
  676.                 # for mainkey and subkey
  677.                 if {[string length $subkeyid] > 0} {
  678.                     set pgp($v,pass,$subkeyid) $password
  679.             Pgp_SetPassTimeout $v $subkeyid
  680.                 }
  681.             }
  682.             return $password
  683.         }
  684.     }
  685. }
  686.  
  687. proc Pgp_SetPassTimeout {v keyid} {
  688.     global pgp
  689.  
  690.     if [info exists pgp(timeout,$keyid)] {
  691.     Exmh_Debug "Cancelling previous timeout for $keyid"
  692.     after cancel $pgp(timeout,$keyid)
  693.     unset pgp(timeout,$keyid)
  694.     }
  695.     Exmh_Debug "Setting timeout for $keyid ($v) in $pgp(passtimeout) minutes"
  696.     set pgp(timeout,$keyid) \
  697.         [after [expr $pgp(passtimeout) * 60 * 1000] \
  698.                [list Pgp_ClearPassword $v $keyid]]
  699. }
  700.  
  701. # wipe password away
  702. proc Pgp_ClearPassword { v {keyid {}} } {
  703.     global pgp
  704.  
  705.     if {[string length $keyid] == 0} {
  706.         foreach index [array names pgp $v,pass*] {
  707.         Exmh_Debug "Clearing pgp($index)"
  708.             set pgp($index) {}
  709.         }
  710.         set pgp($v,pass,) {}
  711.     } else {
  712.     catch {Exmh_Debug "Clearing only pgp($v,pass,$keyid)"}
  713.         catch {set pgp($v,pass,$keyid) {}}
  714.     }
  715. }
  716.  
  717. proc Pgp_Exec_GetKeys { v keyid file } {
  718.     global pgp
  719.  
  720.     Exmh_Debug "Pgp_Exec_GetKeys $v $keyid $file"
  721.  
  722.     set arglist [subst [set pgp($v,args_exportKey)]]
  723.     ldelete arglist {}
  724.     if [Pgp_Exec $v key $arglist msg] {
  725.         error $msg
  726.     } else {
  727.         Pgp_Exec_CheckSuccess $v $file $msg "key block for $keyid"
  728.     }
  729. }
  730.  
  731. # Shutdown Cleanup
  732. proc Pgp_CheckPoint {} {
  733.     foreach cmd { Pgp_Match_CheckPoint } {
  734.         if {[info command $cmd] != {}} {
  735.             if [catch {$cmd} err] {
  736.                 puts stderr "$cmd: $err"
  737.             }
  738.         }
  739.     }
  740. }
  741.  
  742.  
  743. ### Init ###
  744.  
  745. proc Pgp_Exec_Init {} {
  746.     global env pgp
  747.  
  748.     Pgp_SetPath
  749.  
  750.     # needed in pgpMatch
  751.     if {![info exists env(LOCALHOST)]} {
  752.         if [catch {exec uname -n} env(LOCALHOST)] {
  753.             set env(LOCALHOST) localhost
  754.         }
  755.     }
  756.  
  757.     foreach v $pgp(supportedversions) {
  758.         if {[set pgp($v,enabled)]} {
  759.             set pgp($v,pass,) {}
  760.             # Parse config file
  761.             if { [set pgp($v,parse_config)] } {
  762.                 Pgp_Exec_ParseConfigTxt $v [set pgp($v,configFile)]
  763.             }
  764.             if {![file exists [set pgp($v,secring)]]} {
  765.                 set pgp($v,secring) {}
  766.             }
  767.             set pgp($v,privatekeys) [Pgp_Exec_KeyList $v $pgp($v,ownPattern) Sec]
  768.             #
  769.             if [info exists pgp($v,config,myname)] {
  770.                 set myname [string tolower [set pgp($v,config,myname)]]
  771.                 foreach key [set pgp($v,privatekeys)] {
  772.                     if {[string first $myname [string tolower $key]] >= 0} {
  773.             # pgp($v,myname) holds the default key to use
  774.             # for each version of PGP.  It will be used
  775.             # to initialize pgp($v,myname,$id) in each
  776.             # sedit window.
  777.                         set pgp($v,myname) $key
  778.                         break
  779.                     }
  780.                 }
  781.                 if {![info exists pgp($v,myname)]} {
  782.                     if [catch {Pgp_Match_Simple $v [set pgp($v,config,myname)] Sec} key] {
  783.                         tk_messageBox -type ok -icon warning \
  784.                                       -title "[set pgp($v,fullName)] Init" \
  785.                                       -message "The name specified in your [set pgp($v,fullName)] config file couldn't be unambiguously found in your key rings !"
  786.                         set pgp($v,myname) {}
  787.                     } else {
  788.                         set pgp($v,myname) $key
  789.                     }
  790.                 }
  791.             } else {
  792.                 set pgp($v,myname) [lindex [set pgp($v,privatekeys)] 0]
  793.             }
  794.         }
  795.     }
  796. }
  797.